home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / SCR2DBF.COD < prev    next >
Text File  |  1993-05-23  |  11KB  |  363 lines
  1. $Header:   /cms/ports.v/src/dbb/scr2dbf.cod,v   1.0   07 Apr 1993 17:44:44   chofmann  $
  2. NAME  
  3.   SCR2DBF.COD - Creates a DBF file based in the contents of a given SCR
  4.  
  5. DESCRIPTION
  6.   Scr2Dbf will take a SNL file made from a SCR file and create a program
  7.   that makes a DBF file.  This intended to hook in to the OACC for 
  8.   building dialog boxes, or even screens for that matter.
  9.  
  10.   The long character fields, those that accept 80 or more characters, 
  11.   will be stored as MEMO fields.  The memo block size will be reduced to
  12.   64 for compression purposes.
  13.  
  14.   Scr2Dbf will place TEXT strings into the TEMPLATE holder, designate
  15.   the field is a calc field of type (FLD_VALUE_TYPE) "T".
  16.  
  17.   For boxes, instead of extending the structure to handle the extra box
  18.   attributes, Scr2Dbf will store the box in a calc field of type 
  19.   (FLD_VALUE_TYPE) "B", and place the other attributes into the 
  20.   following places:  
  21.     BOX_TYPE -> FLD_MEM_TYP, BOX_SPECIAL_CHAR -> FLD_FILENAME, 
  22.     BOX_LEFT -> ROW_POSITN, BOX_TOP -> COL_POSITN, BOX_WIDTH -> FLD_LENGTH,
  23.     BOX_HEIGHT -> FLD_DECIMALS.
  24.  
  25.   Scr2Dbf will ignore the SCR header information, such as FRAME_PATH,
  26.   or FRAME_MUN_OF_FIELDS, once it has determined that is processing
  27.   a form object.
  28.  
  29.   Scr2Dbf will store values in order of occurance, from top left to
  30.   bottom right.
  31.  
  32.   The generated program will always be called Scr2Dbf for now.  The
  33.   DBF file it creates will also be called Scr2Dbf.  This is to avoid
  34.   conflicts where the form name is the same as an existing DBF file.
  35.  
  36. ASSUMPTIONS
  37.   SFX_LIB, which contains routines like _MakeExte(), is loaded as SYSPROC.
  38.  
  39. {
  40. include "form.def"    // Form selectors
  41. include "builtin.def" // Builtin functions
  42.  
  43.  if getenv("dtl_debug") then
  44.    debug(2)
  45.    breakpoint( pick_debug )
  46.  endif
  47.  
  48. //
  49. // Enum string constants for international translation
  50. //
  51.   enum TRUE  = 1,
  52.        FALSE = 0,
  53.        offset = 2,         // Offset for lmarg()
  54.        range_require  = 2, // Bit for range required set
  55.        valid_required = 4, //  "   "  edit     "      "
  56.        screen_width = 80,  // Screen width for now
  57.        err_ext = ".err"
  58.        ;
  59.  
  60.   var bnl_formname,     // Name of BNL file to newframe if argument() has value
  61.       create_error,     // Indicates if there were problems creating programs
  62.       arg_list;
  63.  
  64.   arg_list = argument()
  65.   if arg_list != "" then
  66.     bnl_formname = token( ",", arg_list, 1 )
  67.     if !newframe( bnl_formname ) then
  68.       return -1;
  69.     endif
  70.   endif
  71.  
  72.   if FRAME_CLASS != form then // We are not processing a form object
  73.     pause(wrong_class + any_key)
  74.     goto NoGen;
  75.   endif
  76.  
  77.   if not create( "scr2dbf.prg" ) then
  78.     pause( "Could not create file: SCR2DBF.PRG" )
  79.     return 0;
  80.   endif
  81.  
  82.   write_prg_header();
  83.  
  84.   //-- Scan all the elements
  85.   foreach ELEMENT k
  86.  
  87.     case ELEMENT_TYPE of
  88.  
  89.       @TEXT_ELEMENT:
  90. }
  91.   APPEND BLANK
  92.   REPLACE template    WITH {delimit_string( TEXT_ITEM )}
  93.   REPLACE fieldtype   WITH "5"
  94.   REPLACE value_type  WITH "T"
  95.   REPLACE row         WITH {nul2zero( ROW_POSITN ) }
  96.   REPLACE col         WITH {nul2zero( COL_POSITN ) }
  97.   REPLACE sys_flen    WITH {nul2zero( SYS_FLEN ) }
  98.   REPLACE display     WITH {nul2zero( FLD_DISPLAY ) }
  99.  
  100. {
  101.  
  102.       @BOX_ELEMENT:
  103. }
  104.   APPEND BLANK
  105.   REPLACE descript    WITH 'BOX'
  106.   REPLACE fieldtype   WITH "6"
  107.   REPLACE value_type  WITH "B"
  108.   REPLACE mem_typ     WITH {nul2zero( BOX_TYPE ) }
  109.   REPLACE filename    WITH {delimit_string( BOX_SPECIAL_CHAR )}
  110.   REPLACE row         WITH {nul2zero( BOX_TOP ) }
  111.   REPLACE col         WITH {nul2zero( BOX_LEFT ) }
  112.   REPLACE length      WITH {nul2zero( BOX_WIDTH ) }
  113.   REPLACE decimals    WITH {nul2zero( BOX_HEIGHT ) }
  114.   REPLACE display     WITH {nul2zero( FLD_DISPLAY ) }
  115.  
  116. {
  117.  
  118.       @FLD_ELEMENT:
  119. }
  120.   APPEND BLANK
  121.   REPLACE fieldname   WITH '{FLD_FIELDNAME}'
  122.   REPLACE fieldtype   WITH '{nul2zero( FLD_FIELDTYPE ) }'
  123.   REPLACE value_type  WITH '{chr( FLD_VALUE_TYPE )}'
  124.   REPLACE filename    WITH '{FLD_FILENAME}'
  125.   REPLACE row         WITH {nul2zero( ROW_POSITN ) }
  126.   REPLACE col         WITH {nul2zero( COL_POSITN ) }
  127.   REPLACE sys_flen    WITH {nul2zero( SYS_FLEN ) }
  128.   REPLACE length      WITH {nul2zero( FLD_LENGTH ) }
  129.   REPLACE decimals    WITH {nul2zero( FLD_DECIMALS ) }
  130.   REPLACE template    WITH {delimit_string( FLD_TEMPLATE )}
  131.   REPLACE picfun      WITH {delimit_string( FLD_PICFUN )}
  132.   REPLACE pic_choice  WITH {delimit_string( FLD_PIC_CHOICE )}
  133.   REPLACE pic_scroll  WITH {nul2zero( FLD_PIC_SCROLL ) }
  134.   REPLACE descript    WITH {delimit_string( FLD_DESCRIPT )}
  135.   REPLACE expression  WITH {delimit_string( FLD_EXPRESSION )}
  136.   REPLACE l_bound     WITH {delimit_string( FLD_L_BOUND )}
  137.   REPLACE u_bound     WITH {delimit_string( FLD_U_BOUND )}
  138.   REPLACE def_val     WITH {delimit_string( FLD_DEF_VAL )}
  139.   REPLACE ed_cond     WITH {delimit_string( FLD_ED_COND )}
  140.   REPLACE ok_cond     WITH {delimit_string( FLD_OK_COND )}
  141.   REPLACE rej_msg     WITH {delimit_string( FLD_REJ_MSG )}
  142.   REPLACE hlp_msg     WITH {delimit_string( FLD_HLP_MSG )}
  143.   REPLACE mem_typ     WITH {nul2zero( FLD_MEM_TYP ) }
  144.   REPLACE editable    WITH {nul2zero( FLD_EDITABLE ) }
  145.   REPLACE carry       WITH {( FLD_CARRY > 0 ? ".T." : ".F." )}
  146.   REPLACE display     WITH {nul2zero( FLD_DISPLAY ) }
  147.   REPLACE style       WITH {nul2zero( FLD_STYLE ) }
  148.  
  149. {
  150.     endcase
  151.   next k;
  152.  
  153. }
  154.   INDEX ON RECNO()    FOR fieldtype = "5"         TAG Text
  155.   INDEX ON RECNO()    FOR fieldtype = "6"         TAG Box
  156.   INDEX ON STR(groupid,4) + STR(currentid,4) TAG ObjOrder
  157.   INDEX ON fieldname  FOR .NOT. fieldtype $ "56"  TAG Field
  158.  
  159. RETURN
  160. *-- EOP: FillDbf  
  161.  
  162.  
  163. {
  164.  
  165. NoGen:
  166.  
  167. return 0;
  168.  
  169. //-- end: scr2dbf
  170.  
  171. //---------------------------------------
  172. // Template user defined functions follow
  173. //---------------------------------------
  174.  
  175. define write_prg_header()
  176. //-------------------------------------------------------------------
  177. // NAME
  178. //   write_prg_header - creates the program header for Scr2Dbg.prg
  179. //-------------------------------------------------------------------
  180. }
  181. PROCEDURE Scr2Dbf
  182. PARAMETERS pc_DbfName
  183. *----------------------------------------------------------------------------
  184. * NAME
  185. *   Scr2Dbf - Creates a DBF based on an SCR file.
  186. *
  187. * DESCRIPTION
  188. *
  189. * PARAMETERS
  190. *   pc_DbfName = Name of the DBF to create.
  191. *
  192. *----------------------------------------------------------------------------
  193.   IF SET( "TALK" ) = "ON"
  194.     SET TALK OFF
  195.     ll_talk = .t.
  196.   ELSE
  197.     ll_talk = .f.
  198.   ENDIF
  199.  
  200.   lc_tmp = _TmpName( ".DBF" )
  201.   DO WHILE UPPER( lc_tmp ) = UPPER( pc_DbfName )
  202.     lc_tmp = _TmpName( ".DBF" )
  203.   ENDDO
  204.   IF _MakeExte( lc_tmp )
  205.  
  206.     DO MakeStru
  207.  
  208.     DO FillDbf
  209.  
  210.   ELSE
  211.     DO _Err_Box WITH "Could not create the tmp structure file"
  212.   ENDIF
  213.  
  214.   IF ll_talk
  215.     SET TALK ON
  216.   ENDIF
  217.  
  218. RETURN
  219. *-- EOP: Scr2Dbf WITH pc_DbfName
  220.  
  221.  
  222. PROCEDURE MakeStru
  223. *----------------------------------------------------------------------------
  224. * NAME
  225. *   MakeStru - Make the DBF structure for creating the fill DBF file
  226. *
  227. * VARIABLES
  228. *   lc_tmp      = name of the tmp DBF file for the structure
  229. *   pc_DbfName  = name of the actual DBF file to create based on structure
  230. *----------------------------------------------------------------------------
  231.  
  232.   USE ( lc_tmp )
  233.  
  234.   DO AppendFld WITH "FIELDNAME",  "C", 10
  235.   DO AppendFld WITH "FIELDTYPE",  "C", 1
  236.   DO AppendFld WITH "VALUE_TYPE", "C", 1
  237.   DO AppendFld WITH "FILENAME",   "C", 10
  238.   DO AppendFld WITH "ROW",        "N", 5
  239.   DO AppendFld WITH "COL",        "N", 2
  240.   DO AppendFld WITH "SYS_FLEN",   "N", 2
  241.   DO AppendFld WITH "LENGTH",     "N", 3
  242.   DO AppendFld WITH "DECIMALS",   "N", 2
  243.   DO AppendFld WITH "TEMPLATE",   "C", 80
  244.   DO AppendFld WITH "PICFUN",     "C", 10
  245.   DO AppendFld WITH "PIC_CHOICE", "M", 10
  246.   DO AppendFld WITH "PIC_SCROLL", "N", 3
  247.   DO AppendFld WITH "DESCRIPT",   "M", 10
  248.   DO AppendFld WITH "EXPRESSION", "M", 10
  249.   DO AppendFld WITH "L_BOUND",    "M", 10
  250.   DO AppendFld WITH "U_BOUND",    "M", 10
  251.   DO AppendFld WITH "DEF_VAL",    "M", 10
  252.   DO AppendFld WITH "ED_COND",    "M", 10
  253.   DO AppendFld WITH "OK_COND",    "M", 10
  254.   DO AppendFld WITH "REJ_MSG",    "C", 80
  255.   DO AppendFld WITH "HLP_MSG",    "C", 80
  256.   DO AppendFld WITH "MEM_TYP",    "N", 1
  257.   DO AppendFld WITH "EDITABLE",   "N", 1
  258.   DO AppendFld WITH "CARRY",      "L", 1
  259.   DO AppendFld WITH "DISPLAY",    "N", 5
  260.   DO AppendFld WITH "STYLE",      "N", 1
  261.  
  262.   *-- Other interesting fields for future enhancements
  263.   DO AppendFld WITH "PRE_PROC",   "M", 10
  264.   DO AppendFld WITH "POST_PROC",  "M", 10
  265.   DO AppendFld WITH "HELP_PROC",  "M", 10
  266.   DO AppendFld WITH "SELECT",     "M", 10
  267.  
  268.   DO AppendFld WITH "GROUPID",    "N", 4
  269.   DO AppendFld WITH "CURRENTID",  "N", 4
  270.   DO AppendFld WITH "NEXTID",     "N", 4
  271.   DO AppendFld WITH "PREVID",     "N", 4
  272.   DO AppendFld WITH "TLABEL",     "N", 4
  273.   DO AppendFld WITH "PICKKEY",    "C", 1
  274.  
  275.   CREATE ( pc_DbfName ) FROM ( lc_tmp )
  276.  
  277.   ERASE ( lc_tmp )
  278.  
  279. RETURN
  280. *-- EOP: MakeStru
  281.  
  282.  
  283. PROCEDURE AppendFld
  284. PARAMETERS pc_name, pc_type, pn_len
  285. *----------------------------------------------------------------------------
  286. * NAME
  287. *   AppendFld - Adds a new field to a structure extended file
  288. *
  289. * PARAMETERS
  290. *   pc_name    = name of the new field
  291. *   pc_type    = type of the field
  292. *   pn_len     = length of the field
  293. *
  294. *----------------------------------------------------------------------------
  295.   APPEND BLANK
  296.   REPLACE field_name WITH pc_name, ;
  297.           field_type WITH pc_type, ;
  298.           field_len  WITH pn_len
  299.  
  300. RETURN
  301. *-- EOP: AppendFld WITH pc_name, pc_type, pn_len
  302.  
  303.  
  304. PROCEDURE FillDbf
  305. *----------------------------------------------------------------------------
  306. * NAME
  307. *   FillDbf - Fills the DBF with elements from the design surface
  308. *
  309. *----------------------------------------------------------------------------
  310.  
  311.   *---------------------------------
  312.   *-- Start adding the form elements
  313.   *---------------------------------
  314.  
  315. {
  316. return;
  317. //-- eof: write_prg_header
  318. enddef
  319.  
  320. define delimit_string( pC_String )
  321. //---------------------------------------------------------------------
  322. // DESCRIPTION
  323. //   Check the string for embedded string delimiters and use one
  324. //   that will not be a conflict.
  325. //---------------------------------------------------------------------
  326.   var lC_LeftDelim,
  327.       lC_RightDelim,
  328.       lC_Result
  329.       ;
  330.  
  331.   if asc( pC_String ) < 32 then
  332.     if len( pC_String ) == 1 then
  333.       lC_Result = "CHR( " + asc( pC_String ) + " )"
  334.     else
  335.       if len( pC_String ) == 0 then
  336.         lC_Result = "''"
  337.       else
  338.         lC_Result = "REPLICATE( CHR( " + asc( pC_String ) + " ), " +
  339.                     str( len( pC_String ) ) + " )"
  340.       endif
  341.     endif
  342.   else
  343.     //--  Assume single quotes are OK
  344.     lC_LeftDelim = "'"
  345.     lC_RightDelim = "'"
  346.     if at( "'", pC_String ) > 0 then
  347.       if at( "]", pC_String ) > 0 then
  348.         lC_LeftDelim = "\""
  349.         lC_RightDelim = "\""
  350.       else
  351.         lC_LeftDelim = "["
  352.         lC_RightDelim = "]"
  353.       endif
  354.     endif
  355.     lC_Result = lC_LeftDelim + pC_String + lC_RightDelim
  356.   endif
  357.  
  358. return lC_Result;
  359. //-- eof: 
  360. enddef
  361.  
  362.  
  363.